perm filename GAME.LSP[206,LSP] blob sn#544564 filedate 1980-10-25 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DEFPROP GAME 
C00003 00003	Value functions
C00005 00004	Line functions
C00007 00005	Tree functions
C00010 00006	 Game aux fns
C00011 ENDMK
CāŠ—;
(DEFPROP GAME 
 (
 VLMAX
 VMAXLIS
 VLMIN
 VMINLIS
 LMAX
 LMAXLIS
 LMIN
 LMINLIS
 TMAX
 TMAXLIS
 TMIN
 TMINLIS
 RECTIFY
 COMMONTAIL
 COMMONHEAD
 ) FNS)
;;;Value functions

(DEFUN VLMAX (P ALPHA BETA)
  (COND	((TER (RECTIFY P) ALPHA BETA) (IMVAL P))
	(T (VMAXLIS (SUCCESSORS P) ALPHA BETA)) ))

(DEFUN VMAXLIS (U ALPHA BETA)
  (COND	((NULL U) ALPHA)
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP S ALPHA))
		  (VMAXLIS (CDR U) ALPHA BETA))
		 ((LESSP S BETA) (VMAXLIS (CDR U) S BETA))
		 (T BETA)))
	  (VLMIN (CAR U) ALPHA BETA))) ))

(DEFUN VLMIN (P ALPHA BETA)
  (COND	((TER (RECTIFY P) ALPHA BETA) (IMVAL P))
	(T (VMINLIS (SUCCESSORS P) ALPHA BETA)) ))

(DEFUN VMINLIS (U ALPHA BETA)
  (COND	((NULL U) BETA)
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP S ALPHA)) ALPHA)
		 ((LESSP S BETA) (VMINLIS (CDR U) ALPHA S))
		 (T (VMINLIS (CDR U) ALPHA BETA))))
	  (VLMAX (CAR U) ALPHA BETA))) ))
;;;Line functions

(DEFUN LMAX (P ALPHA BETA)
  (COND	((TER (RECTIFY P) ALPHA BETA) (LIST (IMVAL P)))
	(T (LMAXLIS (SUCCESSORS P)(CONS ALPHA (QUOTE ALPHA-CUTOFF)) ALPHA BETA)) ))

(DEFUN LMAXLIS(U LINE ALPHA BETA)
  (COND	((NULL U) (CONS ALPHA LINE))
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP (CAR S) ALPHA))
		  (LMAXLIS (CDR U) LINE ALPHA BETA))
		 ((LESSP (CAR S) BETA)
		  (LMAXLIS (CDR U)
			   (CONS (EXT (CAR U)) (CDR S))
			   (CAR S)
			   BETA))
		 (T (CONS BETA LINE))))
	  (LMIN (CAR U) ALPHA BETA))) ))

(DEFUN LMIN (P ALPHA BETA)
  (COND	((TER (RECTIFY P) ALPHA BETA) (LIST (IMVAL P)))
	(T (LMINLIS (SUCCESSORS P)(CONS BETA (QUOTE BETA-CUTOFF)) ALPHA BETA)) ))

(DEFUN LMINLIS (U LINE ALPHA BETA)
  (COND	((NULL U) (CONS BETA LINE))
	(T
	 ((LAMBDA(S)
	   (COND ((NOT (GREATERP (CAR S) ALPHA)) (CONS ALPHA LINE))
		 ((LESSP (CAR S) BETA)
		  (LMINLIS (CDR U)
			   (CONS (EXT (CAR U)) (CDR S))
			   ALPHA
			   (CAR S)))
		 (T (LMINLIS (CDR U) LINE ALPHA BETA))))
	  (LMAX (CAR U) ALPHA BETA))) ))
;;;Tree functions
(DEFUN TMAX (P ALPHA BETA)
  (COND ((TER (RECTIFY P) ALPHA BETA)
         ((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL P)))
        (T (TMAXLIS (SUCCESSORS P)
		    (CONS ALPHA (QUOTE ALPHA-CUTOFF))
		    NIL
		    ALPHA
		    BETA)) ))

(DEFUN TMAXLIS (U TRMAX TRMIN ALPHA BETA)
  (COND
   ((NULL U) (LIST ALPHA TRMAX TRMIN))
   (T
    ((LAMBDA(S)
      (COND
       ((NOT (GREATERP (CAR S) ALPHA))
	(TMAXLIS (CDR U)
		 TRMAX
		 (CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
		 ALPHA
		 BETA))
       ((LESSP (CAR S) BETA)
	(TMAXLIS (CDR U)
		 (CONS (EXT (CAR U)) (CADR S))
		 (CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
		 (CAR S)
		 BETA))
       (T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
     (TMIN (CAR U) ALPHA BETA))) ))

(DEFUN TMIN (P ALPHA BETA)
  (COND ((TER (RECTIFY P) ALPHA BETA)
         ((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL P)))
        (T (TMINLIS (SUCCESSORS P)
		    NIL
		    (CONS BETA (QUOTE BETA-CUTOFF))
		    ALPHA
		    BETA)) ))

(DEFUN TMINLIS (U TRMAX TRMIN ALPHA BETA)
  (COND ((NULL U) (LIST BETA TRMAX TRMIN))
        (T ((LAMBDA(S)
              (COND ((NOT (GREATERP (CAR S) ALPHA))
	             (LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
                    ((LESSP (CAR S) BETA)
	               (TMINLIS (CDR U)
		                (CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
		                (CONS (EXT (CAR U)) (CADDR S))
		                ALPHA
		                (CAR S)))
                    (T (TMINLIS (CDR U)
		                (CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
		                TRMIN
		                ALPHA
		                BETA))))
           (TMAX (CAR U) ALPHA BETA))) ))
;;; Game aux fns
(DEFPROP RECTIFY
 (LAMBDA(P)
  (PROG	(Z Q)
	(SETQ Q (COMMONTAIL P P1))
   L1	(COND ((EQUAL Q P1) (GO L2)))
	(REVERT)
	(GO L1)
   L2	(SETQ Z (LISTSUBT P P1))
   L3	(COND ((NULL Z) (RETURN P)))
	(UPDATE (CAR Z))
	(SETQ Z (CDR Z))
	(GO L3)))
EXPR)

(DEFPROP COMMONTAIL
 (LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)

(DEFPROP COMMONHEAD
 (LAMBDA(U V)
  (COND	((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
	(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)